home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / bas_int1.zip / SMALLEXE.BAS < prev    next >
BASIC Source File  |  1991-01-26  |  7KB  |  326 lines
  1.     REM $TITLE: 'SMALLEXE'
  2.  
  3.     ' How to create a SMALL QB EXEcutable
  4.     ' T. G. Muench January 1991
  5.  
  6.     REM $INCLUDE: 'C:\QBASIC\QB.BI'
  7.  
  8.     DEFINT A-Z
  9.  
  10.     ' Constants
  11.  
  12.     CONST FALSE = 0
  13.     CONST TRUE = NOT FALSE
  14.  
  15.     ' Global variables
  16.  
  17.     COMMON SHARED INPREG AS REGTYPE
  18.     COMMON SHARED OUTREG AS REGTYPE
  19.     COMMON SHARED CR$, LF$, CRLF$
  20.  
  21.     ' Functions and subprograms
  22.  
  23.     DECLARE FUNCTION FileExist (FILE$)
  24.     DECLARE FUNCTION ReadData$ (DATA$)
  25.     DECLARE FUNCTION ReadTimer& ()
  26.     DECLARE FUNCTION StrToInt& (NUMSTR$)
  27.  
  28.     DECLARE SUB GetInput (PROMPT$, ENTRY$)
  29.     DECLARE SUB InputLine (IOCHAN, BUFSIZE, STATUS, TEXT$)
  30.  
  31. Initialization:
  32.  
  33.     ' Sample string data
  34.  
  35.     DATA$ = "1,2,3,4,5,6,7,8,9,10"
  36.     DATA$ = DATA$ + ",Now,is,the,time,for,all,good,persons,to,come"
  37.  
  38.     ' I/O channel
  39.  
  40.     CHAN = 1
  41.  
  42.     ' Miscellaneous
  43.  
  44.     CR$ = CHR$(13)
  45.     LF$ = CHR$(10)
  46.     CRLF$ = CR$ + LF$
  47.  
  48.     REM $PAGE
  49.  
  50. StartProgram:
  51.  
  52.     PRINT : PRINT "Integers"
  53.     START& = ReadTimer&
  54.     FOR I = 1 TO 10
  55.         PRINT I, StrToInt&(ReadData$(DATA$))
  56.     NEXT I
  57.     PRINT "Ticks = "; ReadTimer& - START&
  58.     CALL GetInput("Press Enter to continue: ", ENTRY$)
  59.  
  60.     PRINT : PRINT "Strings"
  61.     START& = ReadTimer&
  62.     FOR I = 11 TO 20
  63.         PRINT I, ReadData$(DATA$)
  64.     NEXT I
  65.     PRINT "Ticks = "; ReadTimer& - START&
  66.     CALL GetInput("Press Enter to continue: ", ENTRY$)
  67.  
  68.     PRINT : PRINT "Read ASCII file:"
  69.     CALL GetInput("File to read? ", FILE$)
  70.     IF FILE$ = "" THEN
  71.         BEEP : PRINT "No file specified"
  72.     ELSEIF NOT FileExist(FILE$) THEN
  73.         BEEP : PRINT "File not found"
  74.     ELSE
  75.         CALL GetInput("Display lines (Y,N)? ", ENTRY$)
  76.         IF UCASE$(ENTRY$) = "Y" THEN
  77.         DISPLAY = TRUE
  78.         ELSE
  79.         DISPLAY = FALSE
  80.         END IF
  81.         START& = ReadTimer&
  82.         OPEN FILE$ FOR BINARY AS #CHAN
  83.         MAXSIZE = 4 * 1024
  84.         FILESTAT = 1
  85.         DO UNTIL FILESTAT = -1
  86.         CALL InputLine(CHAN, MAXSIZE, FILESTAT, LINE$)
  87.         COUNT = COUNT + 1
  88.         IF DISPLAY THEN
  89.             PRINT LINE$
  90.         END IF
  91.         LOOP
  92.         CLOSE #CHAN
  93.         PRINT : PRINT "Read"; COUNT; "lines"
  94.         PRINT "Ticks = "; ReadTimer& - START&
  95.     END IF
  96.  
  97. EndProgram:
  98.  
  99.     END
  100.  
  101.     REM $PAGE
  102.  
  103.     '[]=============================================================[]
  104.     '[]      Checks to see if a file exists so that it may be     []
  105.     '[]             opened by BASIC            []
  106.     '[]=============================================================[]
  107.  
  108.     FUNCTION FileExist (FILE$) STATIC
  109.  
  110.     NAME$ = FILE$ + CHR$(0)
  111.  
  112.     INPREG.AX = &H3D00
  113.     INPREG.DX = SADD(NAME$)
  114.  
  115.     CALL INTERRUPT(&H21, INPREG, OUTREG)
  116.  
  117.     IF (OUTREG.FLAGS AND 1) THEN
  118.         FileExist = FALSE
  119.     ELSE
  120.         FileExist = TRUE
  121.         '
  122.         ' Close the file handle
  123.         '
  124.         INPREG.AX = &H3E00
  125.         INPREG.BX = OUTREG.AX
  126.         CALL INTERRUPT(&H21, INPREG, OUTREG)
  127.     END IF
  128.  
  129.     END FUNCTION
  130.  
  131.     '[]=============================================================[]
  132.     '[]            Gets user input from the keyboard        []
  133.     '[]=============================================================[]
  134.  
  135.     SUB GetInput (PROMPT$, ENTRY$) STATIC
  136.  
  137.     IF PROMPT$ <> "" THEN
  138.         PRINT PROMPT$;
  139.     END IF
  140.  
  141.     COL = POS(0)
  142.  
  143.     ENTRY$ = ""
  144.     DO WHILE TRUE
  145.         LOCATE CSRLIN, COL, 1
  146.         CHAR$ = INPUT$(1)
  147.         SELECT CASE CHAR$
  148.         CASE CHR$(13)
  149.             PRINT
  150.             EXIT DO
  151.         CASE CHR$(8)
  152.             IF LEN(ENTRY$) > 0 THEN
  153.             ENTRY$ = LEFT$(ENTRY$, LEN(ENTRY$) - 1)
  154.             COL = COL - 1
  155.             LOCATE CSRLIN, COL, 1
  156.             PRINT " ";
  157.             END IF
  158.         CASE ELSE
  159.             ENTRY$ = ENTRY$ + CHAR$
  160.             PRINT CHAR$;
  161.             COL = COL + 1
  162.         END SELECT
  163.     LOOP
  164.  
  165.     END SUB
  166.  
  167.     '[]=============================================================[]
  168.     '[]       Inputs a line of text from the specified file    []
  169.     '[]=============================================================[]
  170.  
  171.     SUB InputLine (IOCHAN, BUFSIZE, STATUS, TEXT$) STATIC
  172.  
  173.     STATIC TOTBYTES&    ' Total #bytes in file
  174.     STATIC BYTES&        ' #Bytes read so far
  175.     STATIC SEEKPOS&        ' Seek position in file
  176.     STATIC SPOS        ' Start of line in buffer
  177.  
  178.     ' Initialize if this is the first call
  179.  
  180.     IF STATUS = 1 THEN
  181.         STATUS = 0
  182.         TOTBYTES& = LOF(IOCHAN)
  183.         BYTES& = 0
  184.         SEEKPOS& = 1
  185.         BUFFER$ = STRING$(BUFSIZE, 0)
  186.         SPOS = 1
  187.     END IF
  188.  
  189.     EPOS = INSTR(SPOS, BUFFER$, CRLF$)
  190.     IF EPOS <> 0 THEN
  191.         '
  192.         ' Easy - have a full line
  193.         '
  194.         TEXT$ = MID$(BUFFER$, SPOS, EPOS - SPOS)
  195.     ELSE
  196.         ' Partial line - read the next block
  197.         '  and assemble the full line
  198.         '
  199.         IF LEFT$(BUFFER$, 1) = CHR$(0) THEN
  200.         TEXT$ = ""
  201.         ELSE
  202.         TEXT$ = MID$(BUFFER$, SPOS, BUFSIZE - SPOS + 1)
  203.         END IF
  204.         IF (SEEKPOS& + BUFSIZE) > TOTBYTES& THEN
  205.         BUFSIZE = TOTBYTES& - SEEKPOS& + 1
  206.         BUFFER$ = STRING$(BUFSIZE, 0)
  207.         END IF
  208.         GET #IOCHAN, SEEKPOS&, BUFFER$
  209.         BYTES& = BYTES& + BUFSIZE
  210.         SEEKPOS& = SEEKPOS& + BUFSIZE
  211.         IF BYTES& = TOTBYTES& THEN
  212.         '
  213.         ' Last block needs ending CRLF
  214.         '
  215.         IF RIGHT$(BUFFER$, 2) <> CRLF$ THEN
  216.             BUFFER$ = BUFFER$ + CRLF$
  217.             BUFSIZE = BUFSIZE + 2
  218.         END IF
  219.         END IF
  220.         IF RIGHT$(TEXT$, 1) = CR$ THEN
  221.         '
  222.         ' Special case - CR at end of previous block
  223.         '
  224.         TEXT$ = LEFT$(TEXT$, LEN(TEXT$) - 1)
  225.         EPOS = 0
  226.         ELSE
  227.         EPOS = INSTR(1, BUFFER$, CRLF$)
  228.         TEXT$ = TEXT$ + MID$(BUFFER$, 1, EPOS - 1)
  229.         END IF
  230.     END IF
  231.  
  232.     ' Point to start of next line
  233.  
  234.     SPOS = EPOS + 2
  235.  
  236.     ' All done? If so set status and deallocate buffer
  237.  
  238.     IF (BYTES& = TOTBYTES& AND EPOS = (BUFSIZE - 1)) THEN
  239.         BUFFER$ = "" ' This doesn't ERASE
  240.         STATUS = -1
  241.     END IF
  242.  
  243.     END SUB
  244.  
  245.     '[]=============================================================[]
  246.     '[]          Returns the next string element from the         []
  247.     '[]            passed data string            []
  248.     '[]=============================================================[]
  249.  
  250.     FUNCTION ReadData$ (DATA$) STATIC
  251.  
  252.     STATIC COUNT    ' Number of times called
  253.     STATIC SPOS     ' Starting pos in string
  254.  
  255.     COUNT = COUNT + 1
  256.     IF COUNT = 1 THEN
  257.         SPOS = 1
  258.     END IF
  259.  
  260.     EPOS = INSTR(SPOS, DATA$, ",")
  261.     IF EPOS = 0 THEN
  262.         '
  263.         ' Assume at end of string
  264.         '
  265.         EPOS = LEN(DATA$) + 1
  266.     END IF
  267.  
  268.     ReadData$ = MID$(DATA$, SPOS, EPOS - SPOS)
  269.  
  270.     SPOS = EPOS + 1
  271.  
  272.     END FUNCTION
  273.  
  274.     FUNCTION ReadTimer& STATIC
  275.  
  276.     '[]=============================================================[]
  277.     '[]     Returns the number of clock ticks since midnight    []
  278.     '[]=============================================================[]
  279.  
  280.     INPREG.AX = &H0000
  281.     CALL INTERRUPT(&H1A, INPREG, OUTREG)
  282.  
  283.     IF OUTREG.DX < 0 THEN
  284.         LO& = 65536 + OUTREG.DX     ' Adjust for signed word
  285.     ELSE
  286.         LO& = OUTREG.DX
  287.     END IF
  288.  
  289.     ReadTimer& = (65536 * OUTREG.CX) + LO&
  290.  
  291.     END FUNCTION
  292.  
  293.     '[]=============================================================[]
  294.     '[]   Returns the long integer equivalent of a numeric string    []
  295.     '[]=============================================================[]
  296.  
  297.     FUNCTION StrToInt& (NUMSTR$) STATIC
  298.  
  299.     IF LEFT$(NUMSTR$, 1) = "-" THEN
  300.         NEGATIVE = TRUE
  301.         WORK$ = RIGHT$(NUMSTR$, LEN(NUMSTR$) - 1)
  302.     ELSE
  303.         NEGATIVE = FALSE
  304.         WORK$ = NUMSTR$
  305.     END IF
  306.  
  307.     VALUE& = 0 : POWER& = 1
  308.  
  309.     FOR INDX = LEN(WORK$) TO 1 STEP -1
  310.         BYTE$ = MID$(WORK$, INDX, 1)
  311.         IF (BYTE$ < "0" OR BYTE$ > "9") THEN
  312.         EXIT FOR
  313.         ELSE
  314.         VALUE& = VALUE& + (POWER& * (ASC(BYTE$) - 48))
  315.         POWER& = 10 * POWER&
  316.         END IF
  317.     NEXT INDX
  318.  
  319.     IF NEGATIVE THEN
  320.         StrToInt& = -VALUE&
  321.     ELSE
  322.         StrToInt& = VALUE&
  323.     END IF
  324.  
  325.     END FUNCTION
  326.